unit uMedaData ;

interface

uses
   Classes,
   Forms,
   Inifiles,
   VirtualTrees,
   TntDialogs,
   Dialogs,
   ActnList ;

type

   TMedaDataItem = class
   private
      fName : string ;
      fStrings : TStringlist ;
   public
      constructor Create ;
      destructor Destroy ; override ;

      property Name : string read fName ;

      function FindField( aField : string ) : Variant ; virtual ; abstract ;
   end ;

   TMedaDataPad = class( TMedaDataItem )
   private
   public
      function FindField( aField : string ) : Variant ; override ;
   end ;

   TMedaDataPart = class( TMedaDataItem )
   private
   public
      function FindField( aField : string ) : Variant ; override ;
   end ;

   TMedaDataBox = class( TMedaDataItem )
   private
   public
      function FindField( aField : string ) : Variant ; override ;
   end ;

   TMedaDataShape = class( TMedaDataItem )
   private
   public
      function FindField( aField : string ) : Variant ; override ;
   end ;

   TMedaDataStack = class( TMedaDataItem )
   private
   public
      function FindField( aField : string ) : Variant ; override ;
   end ;

   TdmMedaData = class( TDataModule )
      TntOpenDialog : TTntOpenDialog ;
      TntSaveDialog : TTntSaveDialog ;
      ActionList : TActionList ;
      actSave : TAction ;
      actOpen : TAction ;
      procedure actSaveUpdate( Sender : TObject ) ;
      procedure actSaveExecute( Sender : TObject ) ;
      procedure DataModuleCreate( Sender : TObject ) ;

   private
      { Private declarations }
      fVST : TVirtualStringTree ;
      fAppPath : string ;
      fFilename : string ;

      function GetParts( index, subindex : string ) : TMedaDataPart ;
      function GetBoxes( index : string ) : TMedaDataBox ;
      function GetPads( index : string ) : TMedaDataPad ;
      function GetShapes( index : string ) : TMedaDataShape ;
      function GetStacks( index, subindex : string ) : TMedaDataStack ;

      procedure SetVST( const Value : TVirtualStringTree ) ;
      procedure GetNodeDataSize( Sender : TBaseVirtualTree ;
         var NodeDataSize : Integer ) ;
      procedure GetText( Sender : TBaseVirtualTree ; Node : PVirtualNode ;
         Column : TColumnIndex ; TextType : TVSTTextType ;
         var CellText : WideString ) ;
      procedure GetImageIndex( Sender : TBaseVirtualTree ; Node : PVirtualNode ;
         Kind : TVTImageKind ; Column : TColumnIndex ; var Ghosted : Boolean ;
         var ImageIndex : Integer ) ;
      procedure DblClick( Sender : TObject ) ;
      procedure Clear ;
      procedure Update ;

      function GetBoxNames( index : integer ) : string ;
      function GetPartNames( index : integer ) : string ;
      function GetShapeNames( index : integer ) : string ;
      function GetStackNames( index : integer ) : string ;
      function GetPadNames( index : integer ) : string ;

      function GetBoxesCount : integer ;
      function GetPartsCount : integer ;
      function GetShapesCount : integer ;
      function GetStacksCount : integer ;
      function GetPadsCount : integer ;

   public
      { Public declarations }
      property VST : TVirtualStringTree read fVST write SetVST ;

      property Parts[ index, subindex : string ] : TMedaDataPart read GetParts ;
      property PartNames[ index : integer ] : string read GetPartNames ;
      property PartsCount : integer read GetPartsCount ;

      property Boxes[ index : string ] : TMedaDataBox read GetBoxes ;
      property BoxNames[ index : integer ] : string read GetBoxNames ;

      property Stacks[ index, subindex : string ] : TMedaDataStack read GetStacks ;
      property StackNames[ index : integer ] : string read GetStackNames ;

      property Pads[ index : string ] : TMedaDataPad read GetPads ;
      property PadNames[ index : integer ] : string read GetPadNames ;

      property Shapes[ index : string ] : TMedaDataShape read GetShapes ;
      property ShapeNames[ index : integer ] : string read GetShapeNames ;
   end ;

   THierType = (
      htPart, htBox, htShape, htStack, htPad,
      htParts, htBoxes, htShapes, htStacks, htPads
      ) ;

   PTreeData = ^TTreeData ;
   TTreeData = record
      aType : THierType ;
      aIndex, aSub : integer ;
   end ;

var
   dmMedaData       : TdmMedaData ;

implementation

uses
   SysUtils,
   uMain
   ;

{$R *.dfm}

{ TMedaDataItem }

constructor TMedaDataItem.Create ;
begin
   fStrings := TStringlist.Create ;
end ;

destructor TMedaDataItem.Destroy ;
begin
   fStrings.Free ;
   inherited ;
end ;

{ TdmMedaData }

procedure TdmMedaData.Clear ;
begin
   if assigned( fVST ) then
      fVST.Clear ;
end ;

procedure TdmMedaData.DblClick( Sender : TObject ) ;
var
   Node             : PVirtualNode ;
   Data             : PTreeData ;
begin
   if assigned( fVST ) then
      with fVST do begin
         Node := FocusedNode ;
         if assigned( Node ) then begin
            actSaveExecute( nil ) ;
            Data := GetNodeData( Node ) ;
            case Data^.aType of
               htParts : fFilename := fAppPath + 'Parts.txt' ;
               htBoxes : fFilename := fAppPath + 'Boxes.txt' ;
               htShapes : fFilename := fAppPath + 'Shapes.txt' ;
               htStacks : fFilename := fAppPath + 'Stacks.txt' ;
               htPads : fFilename := fAppPath + 'Pads.txt' ;
            else
               Exit ;
            end ;
//            frmMain.seData.Lines.LoadFromFile( fFilename ) ;
         end ;
      end ;
end ;

function TdmMedaData.GetBoxesCount : integer ;
var
   b                : TStringlist ;
begin
   Result := 0 ;
   with TInifile.Create( fAppPath + 'Boxes.txt' ) do try
      b := TStringlist.Create ;
      try
         ReadSections( b ) ;
         Result := b.Count ;
      finally
         b.Free ;
      end ;
   finally
      Free ;
   end ;
end ;

function TdmMedaData.GetBoxes( index : string ) : TMedaDataBox ;
begin
   with TInifile.Create( fAppPath + 'Boxes.txt' ) do try
      Result := TMedaDataBox.Create ;
      ReadSection( index, Result.fStrings ) ;
   finally
      Free ;
   end ;
end ;

function TdmMedaData.GetBoxNames( index : integer ) : string ;
var
   b                : TStringlist ;
begin
   Result := '' ;
   with TInifile.Create( fAppPath + 'Boxes.txt' ) do try
      b := TStringlist.Create ;
      try
         ReadSections( b ) ;
         if index < b.Count then
            Result := b[ index ] ;
      finally
         b.Free ;
      end ;
   finally
      Free ;
   end ;
end ;

procedure TdmMedaData.GetImageIndex( Sender : TBaseVirtualTree ;
   Node : PVirtualNode ; Kind : TVTImageKind ; Column : TColumnIndex ;
   var Ghosted : Boolean ; var ImageIndex : Integer ) ;
var
   Data             : PTreeData ;
begin
   if assigned( Node ) then begin
      Data := Sender.GetNodeData( Node ) ;
      case Data^.aType of
         htBoxes : ImageIndex := 0 ;
         htParts : ImageIndex := 1 ;
         htShapes : ImageIndex := 2 ;
         htStacks : ImageIndex := 3 ;
         htPads : ImageIndex := 4 ;
      end ;
   end ;
   Ghosted := False ;
end ;

procedure TdmMedaData.GetNodeDataSize( Sender : TBaseVirtualTree ; var NodeDataSize : Integer ) ;
begin
   NodeDataSize := SizeOf( TTreeData ) ;
end ;

function TdmMedaData.GetPadsCount : integer ;
var
   b                : TStringlist ;
begin
   Result := 0 ;
   with TInifile.Create( fAppPath + 'Pads.txt' ) do try
      b := TStringlist.Create ;
      try
         ReadSections( b ) ;
         Result := b.Count ;
      finally
         b.Free ;
      end ;
   finally
      Free ;
   end ;
end ;

function TdmMedaData.GetPadNames( index : integer ) : string ;
var
   b                : TStringlist ;
begin
   Result := '' ;
   with TInifile.Create( fAppPath + 'Pads.txt' ) do try
      b := TStringlist.Create ;
      try
         ReadSections( b ) ;
         if index < b.Count then
            Result := b[ index ] ;
      finally
         b.Free ;
      end ;
   finally
      Free ;
   end ;
end ;

function TdmMedaData.GetPads( index : string ) : TMedaDataPad ;
begin
   with TInifile.Create( fAppPath + 'Pads.txt' ) do try
      Result := TMedaDataPad.Create ;
      ReadSection( index, Result.fStrings ) ;
   finally
      Free ;
   end ;
end ;

function TdmMedaData.GetPartNames( index : integer ) : string ;
var
   b                : TStringlist ;
begin
   Result := '' ;
   with TInifile.Create( fAppPath + 'Parts.txt' ) do try
      b := TStringlist.Create ;
      try
         ReadSections( b ) ;
         if index < b.Count then
            Result := b[ index ] ;
      finally
         b.Free ;
      end ;
   finally
      Free ;
   end ;
end ;

function TdmMedaData.GetParts( index, subindex : string ) : TMedaDataPart ;
begin
   with TInifile.Create( fAppPath + 'Parts.txt' ) do try
      Result := TMedaDataPart.Create ;
      ReadSection( index, Result.fStrings ) ;
   finally
      Free ;
   end ;
end ;

function TdmMedaData.GetShapesCount : integer ;
var
   b                : TStringlist ;
begin
   Result := 0 ;
   with TInifile.Create( fAppPath + 'Shapes.txt' ) do try
      b := TStringlist.Create ;
      try
         ReadSections( b ) ;
         Result := b.Count ;
      finally
         b.Free ;
      end ;
   finally
      Free ;
   end ;
end ;

function TdmMedaData.GetShapeNames( index : integer ) : string ;
var
   b                : TStringlist ;
begin
   Result := '' ;
   with TInifile.Create( fAppPath + 'Shapes.txt' ) do try
      b := TStringlist.Create ;
      try
         ReadSections( b ) ;
         if index < b.Count then
            Result := b[ index ] ;
      finally
         b.Free ;
      end ;
   finally
      Free ;
   end ;
end ;

function TdmMedaData.GetStacksCount : integer ;
var
   b                : TStringlist ;
begin
   Result := 0 ;
   with TInifile.Create( fAppPath + 'Stacks.txt' ) do try
      b := TStringlist.Create ;
      try
         ReadSections( b ) ;
         Result := b.Count ;
      finally
         b.Free ;
      end ;
   finally
      Free ;
   end ;
end ;

function TdmMedaData.GetShapes( index : string ) : TMedaDataShape ;
begin
   with TInifile.Create( fAppPath + 'Shapes.txt' ) do try
      Result := TMedaDataShape.Create ;
      ReadSection( index, Result.fStrings ) ;
   finally
      Free ;
   end ;
end ;

function TdmMedaData.GetStackNames( index : integer ) : string ;
var
   b                : TStringlist ;
begin
   Result := '' ;
   with TInifile.Create( fAppPath + 'Stacks.txt' ) do try
      b := TStringlist.Create ;
      try
         ReadSections( b ) ;
         if index < b.Count then
            Result := b[ index ] ;
      finally
         b.Free ;
      end ;
   finally
      Free ;
   end ;
end ;

function TdmMedaData.GetStacks( index, subindex : string ) : TMedaDataStack ;
begin
   with TInifile.Create( fAppPath + 'Stacks.txt' ) do try
      Result := TMedaDataStack.Create ;
      ReadSection( index, Result.fStrings ) ;
   finally
      Free ;
   end ;
end ;

procedure TdmMedaData.GetText( Sender : TBaseVirtualTree ; Node : PVirtualNode ;
   Column : TColumnIndex ; TextType : TVSTTextType ; var CellText : WideString ) ;
var
   Data             : PTreeData ;
begin
   if assigned( Node ) then begin
      Data := Sender.GetNodeData( Node ) ;
      if assigned( Data ) then
         case Data^.aType of
            htParts : CellText := 'Parts' ;
            htBoxes : CellText := 'Boxes' ;
            htShapes : CellText := 'Shapes' ;
            htStacks : CellText := 'Stacks' ;
            htPads : CellText := 'Pads' ;
            htPart : CellText := PartNames[ Data^.aIndex ] ;
            htBox : CellText := BoxNames[ Data^.aIndex ] ;
            htShape : CellText := ShapeNames[ Data^.aIndex ] ;
            htStack : CellText := StackNames[ Data^.aIndex ] ;
            htPad : CellText := PadNames[ Data^.aIndex ] ;
         end ;
   end ;
end ;

procedure TdmMedaData.SetVST( const Value : TVirtualStringTree ) ;
begin
   fVST := Value ;
   if assigned( fVST ) then begin
      with fVST do begin
         OnGetNodeDataSize := GetNodeDataSize ;
         OnGetText := GetText ;
         OnGetImageIndex := GetImageIndex ;
         OnDblClick := DblClick ;
      end ;
      Update ;
   end ;
end ;

procedure TdmMedaData.Update ;
var
   Root, Node, ChildNode, GrandChildNode : PVirtualNode ;
   Data, ChildData, GrandChildData : PTreeData ;
   c, i          : integer ;
begin
   if assigned( fVST ) then
      with fVST do try
         BeginUpdate ;
         Clear ;
         NodeDataSize := SizeOf( TTreeData ) ;

         Root := AddChild( nil ) ;
         Data := GetNodeData( Root ) ;
         Data.aType := htBoxes ;
         c := GetBoxesCount ;
         for i := 0 to c - 1 do begin
            ChildNode := AddChild( Root ) ;
            ChildData := GetNodeData( ChildNode ) ;
            ChildData^.aType := htBox ;
            ChildData^.aIndex := i ;
            {
                           for j := 0 to Parts[ i ].Count - 1 do begin
                              GrandChildNode := AddChild( ChildNode ) ;
                              GrandChildData := GetNodeData( GrandChildNode ) ;
                              GrandChildData^.aType := htEntry ;
                              GrandChildData^.aIndex := i ;
                              GrandChildData^.aSub := j ;
                           end ;  }
         end ;

         Root := AddChild( nil ) ;
         Data := GetNodeData( Root ) ;
         Data.aType := htParts ;
         c := GetPartsCount ;
         for i := 0 to c - 1 do begin
            ChildNode := AddChild( Root ) ;
            ChildData := GetNodeData( ChildNode ) ;
            ChildData^.aType := htPart ;
            ChildData^.aIndex := i ;
         end ;

         Root := AddChild( nil ) ;
         Data := GetNodeData( Root ) ;
         Data.aType := htShapes ;
         c := GetShapesCount ;
         for i := 0 to c - 1 do begin
            ChildNode := AddChild( Root ) ;
            ChildData := GetNodeData( ChildNode ) ;
            ChildData^.aType := htShape ;
            ChildData^.aIndex := i ;
         end ;

         Root := AddChild( nil ) ;
         Data := GetNodeData( Root ) ;
         Data.aType := htStacks ;
         c := GetStacksCount ;
         for i := 0 to c - 1 do begin
            ChildNode := AddChild( Root ) ;
            ChildData := GetNodeData( ChildNode ) ;
            ChildData^.aType := htStack ;
            ChildData^.aIndex := i ;
         end ;

         Root := AddChild( nil ) ;
         Data := GetNodeData( Root ) ;
         Data.aType := htPads ;
         c := GetPadsCount ;
         for i := 0 to c - 1 do begin
            ChildNode := AddChild( Root ) ;
            ChildData := GetNodeData( ChildNode ) ;
            ChildData^.aType := htPad ;
            ChildData^.aIndex := i ;
         end ;

         FullExpand( nil ) ;
      finally
         EndUpdate ;
      end ;
end ;

function TdmMedaData.GetPartsCount : integer ;
var
   b                : TStringlist ;
begin
   Result := 0 ;
   with TInifile.Create( fAppPath + 'Parts.txt' ) do try
      b := TStringlist.Create ;
      try
         ReadSections( b ) ;
         Result := b.Count ;
      finally
         b.Free ;
      end ;
   finally
      Free ;
   end ;
end ;

{ TMedaDataPart }

function TMedaDataPart.FindField( aField : string ) : Variant ;
begin

end ;

{ TMedaDataBox }

function TMedaDataBox.FindField( aField : string ) : Variant ;
begin

end ;

{ TMedaDataShape }

function TMedaDataShape.FindField( aField : string ) : Variant ;
begin

end ;

{ TMedaDataPad }

function TMedaDataPad.FindField( aField : string ) : Variant ;
begin

end ;

{ TMedaDataStack }

function TMedaDataStack.FindField( aField : string ) : Variant ;
begin

end ;

procedure TdmMedaData.actSaveUpdate( Sender : TObject ) ;
begin
//   ( Sender as TAction ).Enabled := frmMain.seData.Modified ;
end ;

procedure TdmMedaData.actSaveExecute( Sender : TObject ) ;
begin
   if ( fFilename <> '' ) and frmMain.seData.Modified then begin
      frmMain.seData.Lines.SaveToFile( fFilename ) ;
      frmMain.seData.Modified := False ;
   end ;
end ;

procedure TdmMedaData.DataModuleCreate( Sender : TObject ) ;
begin
   fAppPath := ExtractFilePath( Application.Exename ) ;
end ;

initialization
   dmMedaData := TdmMedaData.Create( nil ) ;

finalization
   dmMedaData.Free ;

end.

